home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 93win / data1.cab / Basic_Plus_Examples / ICECREAM < prev    next >
Encoding:
Text File  |  2005-03-02  |  12.8 KB  |  317 lines
  1. 10    ! *********************************************************************
  2. 20    ! Example: Ice Cream Sundae
  3. 30    !
  4. 40    ! This program is an example of the use of the LIST widget.
  5. 50    ! It displays a panel that contains two LIST widgets -- one in which
  6. 60    ! the MULTISELECT attribute is not set, and another in which the
  7. 70    ! MULTISELECT attribute is set.
  8. 80    !
  9. 90    ! If MULTISELECT is not set (0), only one element can be selected
  10. 100    ! from the widget. If you click on a LIST widget in that mode and then
  11. 110    ! read it, you will get the number of the entry into the LIST.
  12. 120   !
  13. 130    ! If MULTISELECT is set (1), several elements can be selected from
  14. 140    ! the widget. You give the widget an array of a size that matches the
  15. 150    ! number of elements in the LIST. When you click on the LIST entries,
  16. 160    ! as they are selected their corresponding array entries are set to 1.
  17. 170    ! The unselected array entries are set to 0.  (If you click again on a
  18. 180    ! selected entry, its array value is cleared back to 0.)
  19. 190    !
  20. 200    ! The MULTISELECT:0 LIST allows you to select a flavor of ice cream
  21. 210    ! while the MULTISELECT:1 LIST allows you to select all the toppings
  22. 220    ! you like.  When you are done, you press the "GIMME!" button to get
  23. 230    ! your selection. (Actually, all you get when you press the button is
  24. 240    ! an INFORMATION DIALOG that tells you you are out of luck.)
  25. 250   !
  26. 260    ! *********************************************************************
  27. 270   !
  28. 280       CLEAR SCREEN
  29. 290       OPTION BASE 1
  30. 300   !
  31. 310   ! Set color values:
  32. 320   !
  33. 330       INTEGER Black,White,Red,Yellow,Green,Blue,Magenta
  34. 340       Black=0
  35. 350       White=1
  36. 360       Red=2
  37. 370       Yellow=3
  38. 380       Green=4
  39. 390       Blue=6
  40. 400       Magenta=7
  41. 410   !
  42. 420   ! Some variables:
  43. 430   !
  44. 440   !   Buffer$:    Used to display values from MULTISELECT:1 list
  45. 450   !   Select(*):  Gets status of selections from MULTISELECT list
  46. 460   !   A(*):       Gets values from GESCAPE statement to find display size.
  47. 470   !   Nlines:     Gets number of lines of text on display
  48. 480   !   N:          General-purpose variable
  49. 490   !
  50. 500       DIM Buffer$[32]
  51. 510       INTEGER Select(9),A(6),Nlines,N
  52. 520   !
  53. 530   ! Get display resolution
  54. 540   !
  55. 550       REAL Dw,Dh,Vh
  56. 560       GESCAPE CRT,3;A(*)
  57. 570       Dw=A(3)-A(1)+1
  58. 580       Dh=A(4)-A(2)+1
  59. 590       STATUS CRT,13;Nlines
  60. 600       Vh=Dh*(1-6/Nlines)
  61. 610   !
  62. 620   ! Set up dimensions and location for main panel
  63. 630   !
  64. 640       REAL Pw,Ph,Px,Py,Iw,Ih
  65. 650       Pw=340
  66. 660       Ph=310
  67. 670       Px=(Dw-Pw)/2
  68. 680       Py=(Vh-Ph)/2
  69. 690   !
  70. 700   ! Set up the main panel
  71. 710   !
  72. 720       ASSIGN @P TO WIDGET "PANEL";SET ("VISIBLE":0)
  73. 730       CONTROL @P;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  74. 740       CONTROL @P;SET ("TITLE":" Coyote's Ice Cream Emporium")
  75. 750       CONTROL @P;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
  76. 760       STATUS @P;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  77. 770   !
  78. 780   ! The panel contains the two list widgets, with a title
  79. 790   ! LABEL and a value LABEL for both. There are also two
  80. 800   ! PUSHBUTTONs, one to "GIMME" your ice cream, and another
  81. 810   ! to exit the program. The following variables assign
  82. 820   ! assign sizes to these widgets and their locations in
  83. 830   ! the panel.
  84. 840   !
  85. 850   ! These assignments are arranged interdependently, so if
  86. 860   ! you change one the others are adjusted automatically.
  87. 870   !
  88. 880       REAL Gaph,Btnw,Lblh,Listw,Listh,C1,C2,R1,R2,R3,R4,R5
  89. 890   !
  90. 900       Gaph=Ih*.02  ! Vertical gap
  91. 910       Listw=Iw*.44 ! Width of LISTS (and corresponding LABELs)
  92. 920       Listh=Ih*.6  ! Height of LIST widgets
  93. 930       Btnw=Iw*.2   ! Width of the two buttons
  94. 940       Lblh=Ih*.1   ! Height of the four labels
  95. 950   !
  96. 960       C1=(Iw/2-Listw)/2! Column 1 is the location for the MULTISELECT:0 LIST
  97. 970       C2=(Iw/4)-Btnw/2! Column 2 is the location for the GIMME button
  98. 980       C3=Iw/2+C1   ! Column 3 is the location for the MULTISELECT:1 widget
  99. 990       C4=Iw/2+C2   ! Column 4 is the location of the EXIT button
  100. 1000  !
  101. 1010       R1=Gaph    ! Row 1 is the location for the title LABELs
  102. 1020       R2=R1+Lblh+Gaph! Row 2 is the location for the LIST widgets
  103. 1030       R3=R2+Listh+Gaph! Row 3 is the location of the value LABELs
  104. 1040       R4=R3+Lblh ! Row 4 is the bottom of the value LABELs
  105. 1050       R5=R4+((Ih-R4)-Lblh)/2! Row 5 is location of the buttons
  106. 1060  !
  107. 1070       DIM Menu$(9)[20],Topping$(9)[20]! Entry arrays for LIST widgets
  108. 1080  !
  109. 1090  ! Entry array for MULTISELECT:0 widget
  110. 1100  !
  111. 1110       Menu$(1)="  VANILLA"
  112. 1120       Menu$(2)="  CHOCOLATE"
  113. 1130       Menu$(3)="  STRAWBERRY"
  114. 1140       Menu$(4)="  NEAPOLITAN"
  115. 1150       Menu$(5)="  FUDGE RIPPLE"
  116. 1160       Menu$(6)="  HEATH BAR"
  117. 1170       Menu$(7)="  BUTTERFINGER"
  118. 1180       Menu$(8)="  MOCHA"
  119. 1190       Menu$(9)="  PEPPERMINT"
  120. 1200  !
  121. 1210  ! Entry array for MULTISELECT:1 widget
  122. 1220  !
  123. 1230       Topping$(1)="  NUTS"
  124. 1240       Topping$(2)="  BANANAS"
  125. 1250       Topping$(3)="  CHOCOLATE"
  126. 1260       Topping$(4)="  HOT FUDGE"
  127. 1270       Topping$(5)="  STRAWBERRIES"
  128. 1280       Topping$(6)="  WHIPPED CREAM"
  129. 1290       Topping$(7)="  SPRINKLES"
  130. 1300       Topping$(8)="  CHERRY"
  131. 1310       Topping$(9)="  BUTTERSCOTCH"
  132. 1320  !
  133. 1330  ! The following variables provide attributes for
  134. 1340  ! the INFORMATION dialog. Since you must declare
  135. 1350  ! everything for a dialog in the statement that
  136. 1360  ! creates it, it is convenient to define attributes
  137. 1370  ! by putting the attribute names in a string array
  138. 1380  ! and the values in a matching array. You can then
  139. 1390  ! use the arrays to set up the values in a dialog
  140. 1400  ! declaration without having to put everything on
  141. 1410  ! one line.
  142. 1420  !
  143. 1430  ! One thing to remember is that you can match your
  144. 1440  ! attribute array to a numeric or string value array -
  145. 1450  ! but you CANNOT mix the types in the value array.
  146. 1460  ! So, if you want to set attributes with numeric or
  147. 1470  ! string values, you must segregate the attributes
  148. 1480  ! into separate attribute arrays and then use them
  149. 1490  ! attribute arrays and then use them with the
  150. 1500  ! appropriate value arrays.
  151. 1510  !
  152. 1520  ! Since all the attributes but one invoked with the
  153. 1530  ! DIALOG command have numeric values, only one array
  154. 1540  ! is set up. (A font is set as well, but that is
  155. 1550  ! done in the DIALOG invocation itself.)
  156. 1560  !
  157. 1570  ! The X and Y origin of the DIALOG is relative to the
  158. 1580  ! 0,0 coordinate of the display, NOT to the parent
  159. 1590  ! widget. Declaring a dialog box with a parent has
  160. 1600  ! the effect that a user will not be able to click
  161. 1610  ! the parent widget back over the top of the DIALOG.
  162. 1620  !
  163. 1630       DIM Ds$(6)[12],Pr$[32],F$[16]
  164. 1640       DIM Dv(6)
  165. 1650  !
  166. 1660       Ds$(1)="WIDTH"
  167. 1670       Dv(1)=Pw*.75
  168. 1680       Ds$(2)="HEIGHT"
  169. 1690       Dv(2)=Ph*.65
  170. 1700       Ds$(3)="X"
  171. 1710       Dv(3)=Px+(Pw-Dv(1))/2
  172. 1720       Ds$(4)="Y"
  173. 1730       Dv(4)=Py+(Ph-Dv(2))/2
  174. 1740       Ds$(5)="BACKGROUND"
  175. 1750       Dv(5)=Blue
  176. 1760       Ds$(6)="PEN"
  177. 1770       Dv(6)=White
  178. 1780       Pr$="Sorry, all out!"
  179. 1790       F$="12 BY 14,BOLD"
  180. 1800  !
  181. 1810  ! Set up the label for the MULTISELECT:0 LIST. The border is
  182. 1820  ! turned off on the LABELs, so they will not look like buttons.
  183. 1830  !
  184. 1840       ASSIGN @Lbl1 TO WIDGET "LABEL";PARENT @P
  185. 1850       CONTROL @Lbl1;SET ("X":C1,"Y":R1,"WIDTH":Listw,"HEIGHT":Lblh)
  186. 1860       CONTROL @Lbl1;SET ("BACKGROUND":White,"PEN":Black)
  187. 1870       CONTROL @Lbl1;SET ("BORDER":0)
  188. 1880       CONTROL @Lbl1;SET ("FONT":"14 BY 14,BOLD")
  189. 1890       CONTROL @Lbl1;SET ("VALUE":"PICK YOUR FLAVOR:")
  190. 1900  !
  191. 1910  ! Set up the MULTISELECT:0 LIST
  192. 1920  !
  193. 1930       ASSIGN @L1 TO WIDGET "LIST";PARENT @P
  194. 1940       CONTROL @L1;SET ("FONT":"10 BY 16,BOLD")
  195. 1950       CONTROL @L1;SET ("X":C1,"Y":R2,"WIDTH":Listw,"HEIGHT":Listh)
  196. 1960       CONTROL @L1;SET ("BACKGROUND":White,"PEN":Blue)
  197. 1970       CONTROL @L1;SET ("ITEMS":Menu$(*))
  198. 1980  !
  199. 1990  ! Set up the MULTISELECT:0 value LABEL
  200. 2000  !
  201. 2010       ASSIGN @Lbl2 TO WIDGET "LABEL";PARENT @P
  202. 2020       CONTROL @Lbl2;SET ("X":C1,"Y":R3,"WIDTH":Listw,"HEIGHT":Lblh)
  203. 2030       CONTROL @Lbl2;SET ("BACKGROUND":White,"PEN":Blue)
  204. 2040       CONTROL @Lbl2;SET ("BORDER":0)
  205. 2050       CONTROL @Lbl2;SET ("FONT":"10 BY 16,BOLD")
  206. 2060       CONTROL @Lbl2;SET ("VALUE":"")
  207. 2070  !
  208. 2080  ! Set up the MULTISELECT:1 title LABEL
  209. 2090  !
  210. 2100       ASSIGN @Lbl3 TO WIDGET "LABEL";PARENT @P
  211. 2110       CONTROL @Lbl3;SET ("X":C3,"Y":R1,"WIDTH":Listw,"HEIGHT":Lblh)
  212. 2120       CONTROL @Lbl3;SET ("BACKGROUND":White,"PEN":Black)
  213. 2130       CONTROL @Lbl3;SET ("BORDER":0)
  214. 2140       CONTROL @Lbl3;SET ("FONT":"14 BY 14,BOLD")
  215. 2150       CONTROL @Lbl3;SET ("VALUE":"SELECT YOUR TOPPINGS:")
  216. 2160  !
  217. 2170  ! Set up the MULTISELECT:1 LIST
  218. 2180  !
  219. 2190       ASSIGN @L2 TO WIDGET "LIST";PARENT @P
  220. 2200       CONTROL @L2;SET ("FONT":"10 BY 16,BOLD")
  221. 2210       CONTROL @L2;SET ("X":C3,"Y":R2,"WIDTH":Listw,"HEIGHT":Listh)
  222. 2220       CONTROL @L2;SET ("BACKGROUND":White,"PEN":Blue)
  223. 2230       CONTROL @L2;SET ("ITEMS":Topping$(*))
  224. 2240       CONTROL @L2;SET ("MULTISELECT":1)
  225. 2250  !
  226. 2260  ! Set up the MULTISELECT:1 value LABEL
  227. 2270  !
  228. 2280       ASSIGN @Lbl4 TO WIDGET "LABEL";PARENT @P
  229. 2290       CONTROL @Lbl4;SET ("X":C3,"Y":R3,"WIDTH":Listw,"HEIGHT":Lblh)
  230. 2300       CONTROL @Lbl4;SET ("BACKGROUND":White,"PEN":Blue)
  231. 2310       CONTROL @Lbl4;SET ("BORDER":0)
  232. 2320       CONTROL @Lbl4;SET ("FONT":"10 BY 16, BOLD")
  233. 2330       CONTROL @Lbl4;SET ("VALUE":"0 0 0 0 0 0 0 0 0")
  234. 2340  !
  235. 2350  ! Set up the GIMME button
  236. 2360  !
  237. 2370       ASSIGN @B1 TO WIDGET "PUSHBUTTON";PARENT @P
  238. 2380       CONTROL @B1;SET ("X":C2,"Y":R5,"WIDTH":Btnw,"HEIGHT":Lblh)
  239. 2390       CONTROL @B1;SET ("BACKGROUND":Red,"PEN":Black)
  240. 2400       CONTROL @B1;SET ("FONT":"10 BY 12")
  241. 2410       CONTROL @B1;SET ("LABEL":"GIMME!")
  242. 2420  !
  243. 2430  ! Set up the EXIT button
  244. 2440  !
  245. 2450       ASSIGN @B2 TO WIDGET "PUSHBUTTON";PARENT @P
  246. 2460       CONTROL @B2;SET ("X":C4,"Y":R5,"WIDTH":Btnw,"HEIGHT":Lblh)
  247. 2470       CONTROL @B2;SET ("BACKGROUND":Green,"PEN":Black)
  248. 2480       CONTROL @B2;SET ("FONT":"10 BY 12")
  249. 2490       CONTROL @B2;SET ("LABEL":"EXIT")
  250. 2500  !
  251. 2510  ! Turn on the panel and show the widgets
  252. 2520  !
  253. 2530       CLEAR SCREEN
  254. 2540       CONTROL @P;SET ("VISIBLE":1)
  255. 2550  !
  256. 2560  ! Set events and wait for an event to happen
  257. 2570  !
  258. 2580       ON EVENT @L1,"SELECTION" GOSUB Onesel! MULTISELECT:0 LIST select
  259. 2590       ON EVENT @L2,"SELECTION" GOSUB Multisel! MULTISELECT:1 LIST select
  260. 2600       ON EVENT @B1,"ACTIVATED" GOSUB Icecream! Click on GIMME button
  261. 2610       ON EVENT @B2,"ACTIVATED" GOTO Finis! Click on EXIT button
  262. 2620  !
  263. 2630       LOOP
  264. 2640           WAIT FOR EVENT
  265. 2650       END LOOP
  266. 2660  !
  267. 2670  ! ********** End of Main Program **************************
  268. 2680  !
  269. 2690  ! This routine handles a mouse click on the MULTISELECT:0 LIST.
  270. 2700  ! list. This routine gets the SELECTION value from the LIST
  271. 2710  ! widget and then puts it into the corresponding value LABEL.
  272. 2720  !
  273. 2730  ! The SELECTION value is the index into the entry array. The
  274. 2740  ! index assumes a base array index of 0 even if OPTION BASE 1
  275. 2750  ! is set (as it is in this program). This means that if you
  276. 2760  ! selected the entry corresponding to array element 1, you
  277. 2770  ! would get a value back of 0.
  278. 2780  !
  279. 2790  Onesel:!
  280. 2800       STATUS @L1;RETURN ("SELECTION":N)
  281. 2810       CONTROL @Lbl2;SET ("VALUE":N)
  282. 2820       RETURN
  283. 2830 !
  284. 2840 ! This is the handler routine for the MULTISELECT:1 LIST.
  285. 2850 ! This routine gets the SELECTION array and then lists ALL
  286. 2860 ! the values in the array in the corresponding LABEL.
  287. 2870 ! The array entry will be 1 for a selected entry, and 0
  288. 2880 ! for an unselected entry.
  289. 2890 !
  290. 2900  Multisel:!
  291. 2910       STATUS @L2;RETURN ("SELECTION":Select(*))
  292. 2920       Buffer$=""
  293. 2930       FOR N=1 TO 9
  294. 2940           Buffer$=Buffer$&VAL$(Select(N))&" "
  295. 2950       NEXT N
  296. 2960       CONTROL @Lbl4;SET ("VALUE":Buffer$)
  297. 2970       RETURN
  298. 2980 !
  299. 2990 ! This is the handler for the GIMME button. It displays a
  300. 3000 ! a DIALOG and tells the user that he or she is out of luck.
  301. 3010 ! (It is for display only and for an example of using a
  302. 3020 ! DIALOG box.) A timeout is set so that the DIALOG
  303. 3030 ! disappears after 5 seconds if the user does nothing.
  304. 3040 !
  305. 3050  Icecream:!
  306. 3060       BEEP 10000,.01
  307. 3070       DIALOG "INFORMATION",Pr$;SET (Ds$(*):Dv(*),"FONT":F$),TIMEOUT 5
  308. 3080       RETURN
  309. 3090 !
  310. 3100 ! This code closes the main panel, clears the screen, and displays "DONE"
  311. 3110 !
  312. 3120  Finis:!
  313. 3130       ASSIGN @P TO *     ! Closes widget
  314. 3140       CLEAR SCREEN
  315. 3150       DISP "DONE"
  316. 3160       END
  317.